home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / EDUCNOMY / HERSCHEL.LZH / HBASE.PAS < prev    next >
Pascal/Delphi Source File  |  1986-12-26  |  49KB  |  1,123 lines
  1. Program HerschelCatalogDataBase (Input,Output);
  2.  
  3. { This program is a simple data base manager for the Herschel catalog of
  4.   deep sky objects, for amateur astronomers. }
  5.  
  6. {$C-}  { No user breaks - to speed screen output }
  7.  
  8. Const
  9.   NumberOfRecords = 2510; { Number of records currently in the data file }
  10.   NumberOfConstellations = 88; { Serpens is treated as a single constellation }
  11.   Heading : String[70] = { The typed constant generates less object code }
  12.   '   H Class   RNGC     R.A.       Dec.   Mag.        Type         Const';
  13.  
  14. Type
  15.   HRecord = Record { The main record description used throughout the program }
  16.               HClass : Byte;    { Byte types are used to save file space }
  17.               HNum   : Integer; { But some fields go over the 0..255 limit }
  18.               NGC    : Integer;
  19.               RAHrs  : Byte;
  20.               RAMins : Byte;
  21.               RASecs : Byte;
  22.               DecDeg : Integer;
  23.               DecMin : Integer; { A neg. DecMin value is used to indicate  }
  24.               Mag    : Byte;    { objects of Dec. 0d.,Xm. which are south  }
  25.               Class  : Byte;    { of the equator by X mins. (needed 'cause }
  26.               Con    : Byte;    { you can't have a DecDeg integer with a   }
  27.             End; { Record }     { value of -0 }
  28.  
  29.   { The following structure is used to build a linked-list which holds the
  30.     entire data file while the program runs. This linked structure is used
  31.     because there is not enough memory left in the data segment for an array. }
  32.  
  33.   HRecordPointer = ^HElement;
  34.                     HElement = Record
  35.                       Data : HRecord;
  36.                       Next : HRecordPointer;
  37.                     End; { Record }
  38.  
  39.   { The following record is used for calling DOS interrupts }
  40.  
  41.   Register = Record
  42.                AX,BX,CX,DX,Bp,SI,DI,DS,ES,Flags: Integer;
  43.              End; { Record }
  44.  
  45.   HClassSet = Set Of 1..8; { Set used in selecting H classes }
  46.   HTypeSet = Set Of 1..7; { Set used in selecting object types }
  47.   Cons = 0..NumberOfConstellations; { Range of constellation indices }
  48.   ConNames = Array[Cons] Of String[3];
  49.   { ConNames is the type description of the "Names" typed constant below }
  50.   Types = Array[1..7] Of String[16];
  51.   { Types is the type description of the "TypeNames" typed constant below }
  52.   Classes = Array[1..8] Of String[4];
  53.   { Classes is the type description of the "TypeNames" typed constant below }
  54.   ObjectType = Array[1..7] Of Char;
  55.   { ObjectType is the type description of the "ObjectTypes" typed constant }
  56.   HArray = Array[1..NumberOfRecords] Of HRecord;
  57.  
  58. { Misc. typed constants follow }
  59.  
  60. Const
  61.   { Typed constant array of constellation names (official abbreviations) }
  62.   Names : ConNames=('   ','And','Ant','Aps','Aqr','Aql','Ara','Ari','Aur','Boo',
  63.    'Cae','Cam','Cnc','CVn','CMa','CMi','Cap','Car','Cas','Cen','Cep','Cet',
  64.    'Cha','Cir','Col','Com','CrA','CrB','Crv','Crt','Cru','Cyg','Del','Dor',
  65.    'Dra','Equ','Eri','For','Gem','Gru','Her','Hor','Hya','Hyi','Ind','Lac',
  66.    'Leo','LMi','Lep','Lib','Lup','Lyn','Lyr','Men','Mic','Mon','Mus','Nor',
  67.    'Oct','Oph','Ori','Pav','Peg','Per','Phe','Pic','Psc','PsA','Pup','Pyx',
  68.    'Ret','Sge','Sgr','Sco','Scl','Sct','Ser','Sex','Tau','Tel','Tri','TrA',
  69.    'Tuc','UMa','UMi','Vel','Vir','Vol','Vul');
  70.  
  71.   { Names of object types used for display }
  72.   TypeNames : Types = ('Open Cluster    ','Globular Cluster',
  73.   'Diffuse Nebula  ','Planetary Nebula','Galaxy          ','Cluster/Nebula  ',
  74.   'Nonexistant     ');
  75.  
  76.   { Object type abbreviations used for display }
  77.   ObjectTypes : ObjectType = ('O','C','D','P','G','/','N');
  78.  
  79.   { Typed constant array of Herschel classes in Roman numeral form }
  80.   ClassNames : Classes = ('   I','  II',' III','  IV','   V','  VI',
  81.                         ' VII','VIII');
  82.  
  83. Var { Misc. global variables }
  84.   FirstPosition,CurrentPosition : HRecordPointer;
  85.   SelectArray : HArray; { User's selected data }
  86.   SelectPointer,LowNGC,HighNGC,LowDecDeg,EndOfArray,VideoOfs,
  87.   HighDecDeg,LowDecMin,HighDecMin,InCount,Index : Integer;
  88.   LowRAHr,HighRAHr,LowRAMin,HighRAMin,Row,Col : Byte;
  89.   LowMag,HighMag,CurrentEpoch,StartTime,FinishTime : Real;
  90.   Constel,TrueConArray : Array[Cons] Of Boolean;
  91.   { The Constel array flags each constellation as selected or not }
  92.   Object : HRecord; { The variable used to hold the current record }
  93.   SortField,Ch : Char; { Variables used for reading key presses }
  94.   OK,AllOK,EndOfInput,Done,Selected,NewSelection,Expanding : Boolean;
  95.   Device : Text; { Procedure WriteALine writes to this file (screen or print) }
  96.   ClassSet : HClassSet; { These sets are used in the selection process }
  97.   TypeSet : HTypeSet;
  98.  
  99. Procedure MemoryWrite(Ch: Char);
  100. { This procedure is a user-written I/O driver for screen output. It writes
  101.   output directly to screen memory. This makes screen output much faster.
  102.   Procedure View activates this driver, and de-activates it before returning
  103.   to the main menu. }
  104.   Const
  105.     VideoSeg = $B000; { Video memory segment address }
  106.   Var
  107.     SChar : Integer;
  108.   Begin { Procedure MemoryWrite }
  109.     If Ch = #13 Then { Test for carriage return }
  110.       Begin { Then }
  111.         Row := Succ(Row); { Adjust row & col for new line }
  112.         Col := 0;
  113.       End { Then }
  114.     Else
  115.       Begin { Else }
  116.         Col := Succ(Col); { New column for each character }
  117.         SChar := ((Row-1)*160) + ((Col-1)*2); { Compute starting location }
  118.         Mem[VideoSeg:VideoOfs + SChar] := Ord(Ch); { Put character in memory }
  119.       End; { Else }
  120.   End; { Procedure MemoryWrite }
  121.  
  122. {$I SORT.BOX}  { Include Borland's SORT.BOX toolbox include file }
  123.  
  124. Procedure ReadList;
  125. { This procedure supplies a single record of input to procedure Inp (below).
  126.   ReadList reads from the static linked list containing the data file. This
  127.   is the normal source of input when the program begins, or after the user
  128.   has done an initialize. }
  129.   Begin { Procedure ReadList }
  130.     Object := CurrentPosition^.Data;
  131.     CurrentPosition := CurrentPosition^.Next;
  132.     EndOfInput := CurrentPosition = Nil;
  133.   End; { Procedure ReadList }
  134.  
  135. Procedure ReadArray;
  136. { This procedure supplies a single record of input to procedure Inp (below).
  137.   ReadArray reads from the SelectArray, which contains the user's currently
  138.   selected data. This array is the source of input whenever the user does a
  139.   second select-and-sort without first reinitializing. }
  140.   Begin { Procedure ReadArray }
  141.     Object := SelectArray[SelectPointer];
  142.     SelectPointer := Succ(SelectPointer);
  143.     EndOfInput := SelectPointer > EndOfArray;
  144.   End; { Procedure ReadArray }
  145.  
  146. Procedure Inp;
  147. { This procedure is called by the Borland sort routines. This is where
  148.   the program compares each object in the select array against the values
  149.   chosen by the user, creating selected input to the sort. }
  150.   Begin { Procedure Inp }
  151.     SelectPointer := 1; { See proc. ReadArray }
  152.     CurrentPosition := FirstPosition; { See proc. ReadList }
  153.     EndOfInput := False; { For procs. ReadList & ReadArray }
  154.     EndOfArray := InCount; { For proc. ReadArray }
  155.     InCount := 0; { Var. to keep track of # of currently selected objects }
  156.     Writeln('Reading and selecting input data'); { Look familiar? }
  157.     Repeat { Loop to extract all valid input to sort }
  158.       If Not Selected Then { All new input required - get it from linked list }
  159.         ReadList
  160.       Else { Else we are selecting from pre-sorted data - use SelectArray }
  161.         ReadArray;
  162.       With Object Do
  163.         Begin { With }
  164.           If                              { <- This if statement is the heart }
  165.             Constel[Con] Then If          { of the program. It does the actual}
  166.             (Class In TypeSet) Then If    { comparing in the selection process}
  167.             (NGC >= LowNGC) Then If       { The use of "Then If's" rather than}
  168.             (NGC <= HighNGC) Then If      { "And's" speeds the comparison     }
  169.             (RAHrs > LowRAHr) Or          { process by eliminating further    }
  170.             ((RAHrs = LowRAHr) And        { comparison as soon as a boolean   }
  171.             (RAMins >= LowRAMin)) Then If {                      test fails.  }
  172.             (RAHrs < HighRAHr) Or         { We test in order of likelyhood -  }
  173.             ((RAHrs = HighRAHr) And       { by const., then object type etc.  }
  174.             (RAMins <= HighRAMin)) Then If
  175.             (DecDeg > LowDecDeg) Or
  176.             ((DecDeg = LowDecDeg) And
  177.             (DecDeg >= 0) And
  178.             (DecMin >= LowDecMin)) Or     { See comment in Object type desc. }
  179.             ((DecDeg = LowDecDeg) And     { concerning neg. DecMin values    }
  180.             (DecDeg < 0) And
  181.             (DecMin <= LowDecMin)) Then If
  182.             ((DecDeg < HighDecDeg) Or
  183.             ((DecDeg = HighDecDeg) And
  184.             (DecMin <= HighDecMin))) Then If
  185.             (Mag >= LowMag) Then If
  186.             (Mag <= HighMag) Then If
  187.             (HClass In ClassSet)
  188.           Then
  189.            Begin { Then }
  190.              SortRelease(Object); { Release object to Borland's sort }
  191.              InCount := Succ(InCount); { Keep count of objects selected }
  192.            End; { Then }
  193.         End; { With }
  194.     Until EndOfInput;
  195.     Selected := True; { User is creating a select array so its ok to precess }
  196.     Writeln(Incount,' records input to sort');
  197.     Writeln('Sorting'); { You'll stare at this line during the actual sort }
  198.   End; { Procedure Inp }
  199.  
  200. Procedure Outp;
  201. { This procedure takes the output from the sort and writes it to the select
  202.   array. This is the array on which all further operations will operate,
  203.   until the user "initializes". This procedure is called from Borland's sort
  204.   routines. }
  205.   Begin { Procedure Outp }
  206.     Writeln('Writing selected output data'); { The last sort screen message }
  207.     For Index := 1 To Incount Do
  208.       Begin { For }
  209.         SortReturn(Object); { Return records in order from Borland's sort }
  210.         SelectArray[Index] := Object; { Put 'em in the SelectArray }
  211.       End; { For }
  212.   End; { Procedure Outp }
  213.  
  214. Function Less; { Foward declared from the include file as type boolean }
  215. { This procedure is called by the Borland sort routines. Here is where the
  216.   actual comparison process for the sort takes place. The case statement
  217.   controls the fields sorted on, depending on the user's choice. }
  218.   Var
  219.     FirstObject : HRecord Absolute X;  { Records are passed to Borland's sort }
  220.     SecondObject : HRecord Absolute Y; { by these absolute variables.  }
  221.   Begin { Function Less }
  222.     Case SortField Of { The same char. the user asked for in proc. Sort }
  223.       'H','h' : Less := (FirstObject.HClass < SecondObject.HClass) Or
  224.                         ((FirstObject.HClass = SecondObject.HClass) And
  225.                         (FirstObject.HNum < SecondObject.HNum));
  226.       'N','n' : Less := FirstObject.NGC < SecondObject.NGC;
  227.       'R','r' : Less := (FirstObject.RAHrs < SecondObject.RAHrs) Or
  228.                         ((FirstObject.RAHrs = SecondObject.RAHrs) And
  229.                         (FirstObJect.RAMins < SecondObject.RAMins)) Or
  230.                         (((FirstObject.RAHrs = SecondObject.RAHrs) And
  231.                         (FirstObject.RAMins = SecondObject.RAMins) And
  232.                         (FirstObject.RASecs < SecondObject.RASecs)));
  233.       'D','d' : Less := (FirstObject.DecDeg < SecondObject.DecDeg) Or
  234.                         ((FirstObject.DecDeg = SecondObject.DecDeg) And
  235.                         (FirstObject.DecDeg < 0) And
  236.                         (FirstObject.DecMin > SecondObject.DecMin)) Or
  237.                         ((FirstObject.DecDeg = SecondObject.DecDeg) And
  238.                         (FirstObject.DecDeg >= 0) And
  239.                         (FirstObject.DecMin < SecondObject.DecMin));
  240.       'M','m' : Less := (FirstObject.Mag < SecondObject.Mag) Or
  241.                         ((FirstObject.Mag = SecondObject.Mag) And
  242.                         ((FirstObject.RAHrs < SecondObject.RAHrs) Or
  243.                         ((FirstObject.RAHrs = SecondObject.RAHrs) And
  244.                         (FirstObJect.RAMins < SecondObject.RAMins)) Or
  245.                         (((FirstObject.RAHrs = SecondObject.RAHrs) And
  246.                         (FirstObject.RAMins = SecondObject.RAMins) And
  247.                         (FirstObject.RASecs < SecondObject.RASecs)))));
  248.       'O','o' : Less := (FirstObject.Class < SecondObject.Class) Or
  249.                         ((FirstObject.Class = SecondObject.Class) And
  250.                         ((FirstObject.RAHrs < SecondObject.RAHrs) Or
  251.                         ((FirstObject.RAHrs = SecondObject.RAHrs) And
  252.                         (FirstObJect.RAMins < SecondObject.RAMins)) Or
  253.                         (((FirstObject.RAHrs = SecondObject.RAHrs) And
  254.                         (FirstObject.RAMins = SecondObject.RAMins) And
  255.                         (FirstObject.RASecs < SecondObject.RASecs)))));
  256.       'C','c' : Less := (FirstObject.Con < SecondObject.Con) Or
  257.                         ((FirstObject.Con = SecondObject.Con) And
  258.                         ((FirstObject.RAHrs < SecondObject.RAHrs) Or
  259.                         ((FirstObject.RAHrs = SecondObject.RAHrs) And
  260.                         (FirstObJect.RAMins < SecondObject.RAMins)) Or
  261.                         (((FirstObject.RAHrs = SecondObject.RAHrs) And
  262.                         (FirstObject.RAMins = SecondObject.RAMins) And
  263.                         (FirstObject.RAsECS < SecondObject.RASecs)))));
  264.     End; { Case }
  265.   End; { Function Less }
  266.  
  267. Procedure Error(ErrorNumber,ErrorAddress : Integer);
  268. { This procedure is a user written error handler. }
  269. { It will execute if an error occurs. }
  270.   Begin { Procedure Error }
  271.     ClrScr;
  272.     Writeln('HBASE has crashed.'); { In case the user hadn't noticed }
  273.     If (Hi(ErrorNumber) = 2) And (Lo(ErrorNumber) = $FF) Then
  274.       Begin { Then }
  275.         Writeln('Insufficient memory for execution.');
  276.         Writeln('Remove any memory resident software and try again.');
  277.       End; { Then }
  278.     If (Hi(ErrorNumber) = 1) And (Lo(ErrorNumber) = 1) Then
  279.       Writeln('File HBASE.DAT must be in current directory of default drive!');
  280.     Halt; { Stop the program "manually" after reporting error }
  281.   End; { Procedure Error }
  282.  
  283. Procedure InitializeVariables;
  284. { This procedure initializes various variables to their origional state. It
  285.   is called from procedure Initialize when the program first begins, and is
  286.   also the procedure called by the initialize option from the main menu. }
  287.   Begin { Procedure InitializeVariables }
  288.     Expanding := False; { Here is where it is reset }
  289.     NewSelection := False; { Nothing has been selected }
  290.     Selected := False; { No data selected yet - can't precess }
  291.     InCount := 0; { Nothing has been selected & sorted yet }
  292.     CurrentEpoch := 1975.0; { The epoch of the data file }
  293.     { The rest of the statements assign values to the selection variables that
  294.       will select for all possible objects. Thus, you get everything until you
  295.       narrow down these values in the selection procedures. }
  296.     SortField := ' ';
  297.     ClassSet := [1..8];
  298.     TypeSet := [1..7];
  299.     LowNGC := 0;
  300.     HighNGC := 8000;
  301.     LowRAHr := 0;
  302.     HighRAHr := 24;
  303.     LowRAMin := 0;
  304.     HighRAMin := 0;
  305.     LowDecDeg := -90;
  306.     HighDecDeg := 90;
  307.     LowDecMin := 0;
  308.     HighDecMin := 0;
  309.     LowMag := 0.0;
  310.     HighMag := 170.0;
  311.     Constel := TrueConArray; { Each element = true, all const. selected }
  312.   End; { Procedure InitializeVariables }
  313.  
  314. Procedure Tab(NumberOfSpaces : Byte);
  315. { Tab over a number of spaces rather than writing space constants }
  316.   Begin { Procedure Tab }
  317.     GoToXY(WhereX + NumberOfSpaces,WhereY);
  318.   End; { Procedure Tab }
  319.  
  320. Procedure WriteTitleScreen;
  321. { Please leave this in place - I don't ask for money - just my name in lights }
  322.   Begin { Procedure WriteTitleScreen }
  323.     Clrscr;
  324.     Writeln; Writeln; Writeln;
  325.     Tab(32); Writeln('║   ║ ');
  326.     Tab(32); Writeln('╠═══╣ ');
  327.     Tab(32); Writeln('║   ║  B A S E');
  328.     Writeln; Writeln; LowVideo;
  329.     Tab(13); Writeln('A project in amateur astronomy by G. Dean Williams');
  330.     Writeln;
  331.     Tab(14); Writeln('Data by Sir William Herschel and Dennis Donnelly');
  332.     GoToXY(67,25); Write('Version 01/87');
  333.   End; { Procedure WriteTitleScreen }
  334.  
  335. Procedure GetScreenType;
  336. { This procedure determines whether the system uses a monochrome or color
  337.   screen. This information is needed in procedure memorywrite. }
  338.   Var
  339.     Registers : Register;
  340.     Result    : Integer;
  341.     ScreenType : Byte;
  342.   Begin { Procedure GetScreenType }
  343.     INTR($11,Registers); { Interrupt to return screen type }
  344.     Result := Registers.AX; { The raw result is in register AX }
  345.     ScreenType := (Result Shl 10 ) Shr 14; { Extract screen type from result }
  346.     If ScreenType = 2 Then
  347.       VideoOfs := $8000 { Color system }
  348.     Else
  349.       VideoOfs := $0000; { Monochrome system }
  350.   End; { Procedure GetScreenType }
  351.  
  352. Function Time: Real; { Get system time for calculating program run time }
  353. Var
  354.   RecPack:          Register;
  355.   Ah,Al,Ch,Cl,Dh :   Byte;
  356. Begin { Function Time }
  357.   Ah := $2c; { Initial vaule before DOS call }
  358.   With RecPack Do
  359.     Begin { With }
  360.       Ax := Ah Shl 8 + Al; { Prepare register value for interrupt }
  361.     End; { With }
  362.   Intr($21,RecPack); { Ask DOS for the time }
  363.   With RecPack Do { Calculate time in seconds }
  364.     Time := (Cx Shr 8) * 3600.0 + (Cx Mod 256) * 60.0 + (Dx Shr 8);
  365. End; { Function Time }
  366.  
  367. Procedure Initialize;
  368. { This procedure is called from the main program when the program starts.
  369.   It initializes a few necessary variables. }
  370.   Var
  371.     InFile : File Of HArray;
  372.     ConIndex : Byte;
  373.   Begin { Procedure Initialize }
  374.     StartTime := Time; { Used to calculate program run time }
  375.     WriteTitleScreen;
  376.     ErrorPtr := Ofs(Error); { Activate the error handler procedure }
  377.     AuxOutPtr := ConOutPtr; { Save ConOutPtr }
  378.     GetScreenType; { Monochrome or color system? }
  379.     Done := False; { See main program block }
  380.     For ConIndex := 0 To NumberOfConstellations Do { Select all cons }
  381.       TrueConArray[ConIndex] := True;
  382.     InitializeVariables;
  383.     Assign(InFile,'HBASE.DAT');
  384.     Reset(Infile); { It had better be there or we'll crash }
  385.     Read(InFile,SelectArray); { Load the select array with one big disk read }
  386.     Close(InFile);
  387.     New(FirstPosition); { Starting place for linked list }
  388.     CurrentPosition := FirstPosition; { Start at the start }
  389.     For Index := 1 To NumberOfRecords Do
  390.       Begin { For loop to load the linked list from the select array }
  391.         CurrentPosition^.Data := SelectArray[Index]; { Load object to list }
  392.         New(CurrentPosition^.Next); { Increment position in liked list }
  393.         CurrentPosition := CurrentPosition^.Next; { Increment CurrentPosition }
  394.       End; { For }
  395.     CurrentPosition^.Next := Nil; { The last linked list entry points nowhere }
  396.     InCount := NumberOfRecords; { All objects are selected & sorted by H # }
  397.   End; { Procedure Initialize }
  398.  
  399. Procedure WaitForSpace; { Wait until user presses space bar }
  400.   Begin { Procedure WaitForSpace }
  401.     Repeat
  402.       Read(Kbd,Ch);
  403.     Until Ch = ' ';
  404.   End; { Procedure WaitForSpace }
  405.  
  406. Procedure Sort;
  407. { This procedure contains the sort menu, chosen from the main menu }
  408.   Var
  409.     SortFieldHold : Char;
  410.     SortResult : Integer;
  411.   Begin { Procedure Sort }
  412.     ClrScr;
  413.     Window(20,1,80,25); { Center sort menu screen }
  414.     Ch := 'Y'; { In case we skip the following read }
  415.     If ((InCount >= NumberOfRecords) And (Not NewSelection))
  416.       Or (Not (Selected Or NewSelection) And (InCount = 0)) Then
  417.         Begin { Then }
  418.           Writeln;
  419.           Write('Really sort the entire catalog? (Y/N): ');
  420.           Repeat { Outer loop to catch those damn escape codes }
  421.             Repeat
  422.               Read(Kbd,Ch);
  423.             Until Upcase(Ch) In ['Y','N',#27];
  424.             If (Ch = #27) And Keypressed Then { Trap escape codes }
  425.               Begin { Then }
  426.                 Read(Kbd,Ch); { Read 2nd char of escape code }
  427.                 Ch := 'a'; { Look out for escape code with  "y" or "n" }
  428.               End; { Then }
  429.           Until Upcase(Ch) In ['Y','N'];
  430.           Writeln(Ch);
  431.         End; { Then }
  432.     If Upcase(Ch) = 'Y' Then { We are going to sort - proceed }
  433.       Begin { Then }
  434.         { The next line saves SortField in case it gets clobbered with "Q" }
  435.         SortFieldHold := SortField;
  436.         Writeln;
  437.         Writeln('You can sort on the following fields:');
  438.         Writeln;
  439.         HighVideo; Write('  H'); LowVideo; Writeln('erschel Class');
  440.         HighVideo; Write('  N'); LowVideo; Writeln('GC Number');
  441.         HighVideo; Write('  R'); LowVideo; Writeln('ight Ascension');
  442.         HighVideo; Write('  D'); LowVideo; Writeln('eclination');
  443.         HighVideo; Write('  M'); LowVideo; Writeln('agnitude');
  444.         HighVideo; Write('  O'); LowVideo; Writeln('bject Type');
  445.         HighVideo; Write('  C'); LowVideo; Writeln('onstellation');
  446.         Writeln;
  447.         Write('Type a letter to sort or "Q" to quit to previous screen: ');
  448.         Repeat { Outer loop to catch unwanted escape codes }
  449.           Repeat
  450.             Read(Kbd,SortField);
  451.           Until Upcase(SortField) In ['H','N','R','D','M','O','C','Q',#27];
  452.           If (SortField = #27) And Keypressed Then { Trap out escape codes }
  453.             Begin { Then }
  454.               Read(Kbd,SortField); { Get 2nd char of escape code }
  455.               SortField := 'a'; { So it isn't a sort field character }
  456.             End; { Then }
  457.         Until Upcase(SortField) In ['H','N','R','D','M','O','C','Q'];
  458.         HighVideo; Writeln(SortField); LowVideo;
  459.         Writeln;
  460.         If Upcase(SortField) <> 'Q' Then { A real sort field was entered }
  461.           Begin { Then }
  462.             NewSelection := False; { Selections are being sorted }
  463.             { The call to the actual sort is in the next line }
  464.             SortResult := TurboSort(SizeOf(HRecord)); { Call sort function }
  465.             If SortResult <> 0 Then { Report sort error }
  466.               Begin { Then }
  467.                 Writeln('--- Error Occured During Sort ---');
  468.                 Case SortResult Of
  469.                   3 : Writeln('Not enough free memory for sorting');
  470.                   10,11 : Writeln('Probable disk I/O error or disk full');
  471.                   12 : Writeln('Disk directory full');
  472.                 End; { Case SortResult }
  473.                 Write('Press Space To Continue');
  474.                 WaitForSpace;
  475.               End; { Then }
  476.           End { Then }
  477.         Else { The user did a "Q", so restore SortField }
  478.           SortField := SortFieldHold;
  479.       End; { Then }
  480.   End; { Procedure Sort }
  481.  
  482. Procedure WriteALine;
  483. { This procedure writes a single line of output, either to the screen,
  484.   or to the printer. It is called by procedures List and View. }
  485.  Var
  486.    RealMag : Real;
  487.  Begin { Procedure WriteALine }
  488.   With Object Do
  489.     Begin { With }
  490.       Write(Device,'   ',ClassNames[HClass],'-');
  491.       { Classnames are the roman numeral classes stored in ClassNames array }
  492.       If HNum < 10 Then    { We must test for & print all leading zeros so }
  493.         Write(Device,'00') { that all field columns line up evenly. }
  494.       Else
  495.         If HNum < 100 Then
  496.           Write(Device,'0');
  497.       Write(Device,HNum,'   ');
  498.       If NGC < 10 Then
  499.         Write(Device,'000')
  500.       Else
  501.         If NGC < 100 Then
  502.           Write(Device,'00')
  503.         Else
  504.           If NGC < 1000 Then
  505.             Write(Device,'0');
  506.       Write(Device,NGC,'   ');
  507.       If RAHrs < 10 Then
  508.         Write(Device,'0');
  509.       Write(Device,RAHrs,'/');
  510.       If RAMins < 10 Then
  511.         Write(Device,'0');
  512.       Write(Device,RAMins,'/');
  513.       If RASecs < 10 Then
  514.         Begin { Then }
  515.           Write(Device,'0');
  516.           Write(Device,RASecs:1,'   ');
  517.         End { Then }
  518.       Else
  519.         Write(Device,RASecs:2,'   ');
  520.       If (DecDeg < 0) Or (DecMin < 0) Then
  521.         Write(Device,'-')
  522.       Else
  523.         Write(Device,' ');
  524.       DecDeg := Abs(DecDeg); { We print neg. sign manually }
  525.       If Decdeg < 10 Then
  526.         Begin { Then }
  527.           Write(Device,'0');
  528.           Write(Device,DecDeg,'/');
  529.         End { Then }
  530.       Else
  531.         Write(Device,DecDeg,'/');
  532.       DecMin := Abs(DecMin); { See note in HRecord type description }
  533.       If DecMin < 10 Then
  534.         Write(Device,'0');
  535.       Write(Device,DecMin,'   ');
  536.       RealMag := Mag;
  537.       RealMag := RealMag / 10; { Magnitudes are all multiplied by 10 so }
  538.       If RealMag < 10 Then     { they can be stored as bytes & save space }
  539.         Begin { Then }
  540.           Write(Device,'0');
  541.           Write(Device,RealMag:3:1,'   ');
  542.         End { Then }
  543.       Else
  544.         Write(Device,RealMag:4:1,'   ');
  545.       Write(Device,TypeNames[Class]);
  546.       Write(Device,'   ',Names[Con],#13); { Write carriage return at end }
  547.     End; { With }
  548.   End; { Procedure WriteALine }
  549.  
  550. Procedure List;
  551. { This procedure sends the selected data to the printer }
  552.   Const
  553.     FormFeed = #12;
  554.   Var
  555.     NumberOfReports,CopyCount,LineCount : Byte;
  556.   Begin { Procedure List }
  557.     If NewSelection Then
  558.       Sort; { User cannot list data until it is sorted }
  559.     Assign(Device,'Lst:'); { So WriteALine will write to printer }
  560.     Reset(Device);
  561.     If InCount > 0 Then { There is something selected to print }
  562.       Begin { Then }
  563.         NumberOfReports := 1; { Default so user can just hit enter for 1 }
  564.         Writeln;
  565.         Repeat { Loop to get # of listings }
  566.           Write('Enter desired number of copies (default is 1): ');
  567.           {$I-} Readln(NumberOfReports) {$I+};
  568.           OK := (IoResult = 0) And (NumberOfReports > 0) And
  569.                 (NumberOfReports < 251);
  570.           If Not OK Then
  571.             Write(^G); { Ring bell to alert user to entry error }
  572.           If NumberOfReports > 250 Then
  573.             Writeln('The maximum number of listings is 250!');
  574.           Writeln;
  575.         Until OK;
  576.         ClrScr;
  577.         Writeln('Ready printer and press space to proceed');
  578.         Writeln('You can type "Q" at any time to stop printing ');
  579.         WaitForSpace;
  580.         CopyCount := 0;
  581.         Repeat { Loop for number of copies }
  582.           CopyCount := Succ(CopyCount);
  583.           GotoXY(1,4); { So object count will stay put between copies }
  584.           Writeln('List of selected objects going to printer.');
  585.           For LineCount := 1 To 3 Do
  586.             Writeln(Lst);
  587.           Writeln(Lst,' ',Heading);
  588.           Writeln(Lst);
  589.           LineCount := 5;
  590.           SelectPointer := 0;
  591.           Repeat { Loop for writing all selected objects }
  592.             SelectPointer := Succ(SelectPointer);
  593.             GoToXY(1,5); { Position for the following write statements }
  594.             Write(Succ(InCount) - SelectPointer,' objects left to print');
  595.             Write(' on copy ',CopyCount,' of ',NumberOfReports,'.    ');
  596.             If KeyPressed Then
  597.               Begin { Then }
  598.                 Read(Kbd,Ch); { Get the character }
  599.                 If (Ch = #27) And Keypressed Then { Extended scan code? }
  600.                   Begin { Then }
  601.                     Read(Kbd,Ch); { Get 2nd character of scan code }
  602.                     Ch := 'a'; { Trap unwanted "Q"s }
  603.                   End; { Then }
  604.                 If Upcase(Ch) = 'Q' Then
  605.                   SelectPointer := Incount; { Skip to end of list to stop }
  606.               End; { Then }
  607.             Object := SelectArray[SelectPointer]; { Get object to print }
  608.             WriteALine; { Write it to Lst: device }
  609.             Write(Lst,#10); { Line feed after carriage return from WriteALine }
  610.             LineCount := Succ(LineCount); { Keep count of print lines }
  611.             If LineCount > 62 Then { Time for new page }
  612.               Begin { Then }
  613.                 Write(Lst,FormFeed); { Form Feed At End Of Each Page }
  614.                 For LineCount := 1 To 3 Do
  615.                   Writeln(Lst);
  616.                 Writeln(Lst,' ',Heading);
  617.                 Writeln(Lst);
  618.                 LineCount := 5; { Adjust for heading lines }
  619.               End; { Then }
  620.           Until SelectPointer = Incount; { The last object }
  621.           Write(Lst,FormFeed); { Final form feed between copies }
  622.         Until (CopyCount = NumberOfReports) Or (Upcase(Ch) = 'Q');
  623.       End { Then }
  624.     Else
  625.       Begin { Else }
  626.         Write('No objects to list - Press Space To Continue ');
  627.         WaitForSpace;
  628.       End; { Else }
  629.   End; { Procedure List }
  630.  
  631. Procedure View;
  632. { This procedure contains the on-screen editor code }
  633.   Const
  634.     Escape = #27;
  635.   Var
  636.     PagePointer : Integer;
  637.     MaxDetailLines,Count : Byte;
  638.     FunKey,TopOfList,BottomOfList : Boolean;
  639.  
  640.   Procedure WriteScreen;
  641.   { This procedure is contained in, and is called by procedure view. It's
  642.     purpose is to write a screenful of output on the screen. }
  643.     Begin { Procedure WriteScreen }
  644.       ClrScr;
  645.       MaxDetailLines := 23; { Maximum detail lines on the view screen }
  646.       TopOfList := (PagePointer = 0);
  647.       If TopOfList Then { Write ** Top Of List ** message at top }
  648.         MaxDetailLines := Pred(MaxDetailLines); { Leave space for message }
  649.       BottomOfList := (InCount - PagePointer < MaxDetailLines);
  650.       If BottomOfList Then { Write ** Bottom Of List message at bottom }
  651.         MaxDetailLines := Pred(MaxDetailLines); { Leave space for message }
  652.       If InCount = 22 Then
  653.         MaxDetailLines := 21; { Don't write all 22 lines without message }
  654.       Row := 1; { For procedure MemoryWrite }
  655.       Col := 1;
  656.       Write(' Seq.',Heading,#13,#13); { Heading, CR, and & blank line }
  657.       If TopOfList Then
  658.         Write('                         *****   Top Of List   *****',#13);
  659.       Count := 0;
  660.       While (Count < MaxDetailLines) And (PagePointer + Count < InCount) Do
  661.         Begin { While loop to write a screenful of object lines }
  662.           Count := Succ(Count); { Index for SelectArray }
  663.           Object := SelectArray[PagePointer + Count]; { Get object to list }
  664.           Write(' ',PagePointer + Count:4); { Sequence # for listing }
  665.           WriteALine; { Write object to Con: device }
  666.         End; { While }
  667.       If BottomOfList Then
  668.         Write('                        *****   Bottom Of List   *****',#13);
  669.     End; { Procedure WriteScreen }
  670.  
  671.   Begin { Procedure View }
  672.     If NewSelection Then
  673.       Sort; { User cannot view data until it is sorted }
  674.     ConOutPtr := Ofs(MemoryWrite); { Activate screen output driver }
  675.     Assign(Device,'Con:'); { So WriteALine will write to the screen }
  676.     Reset(Device);
  677.     FunKey := False; { A cursor control key has not been pressed }
  678.     Window(1,1,80,25); { Set window size to entire screen }
  679.     If InCount > 0 Then { There is something selected to view }
  680.       Begin { Then }
  681.         PagePointer := 0; { Index to top of SelectArray }
  682.         WriteScreen; { Write initial screenful of output }
  683.         Repeat { Accept keyboard input until user "q"uits }
  684.           Repeat
  685.             Read(Kbd,Ch);
  686.             FunKey := (Ch = Escape) And KeyPressed;
  687.           Until FunKey Or (Upcase(Ch) In ['Q','B','E','S']);
  688.           If FunKey And (InCount > 21) Then { Respond to edit keys }
  689.             Begin { Then }
  690.               FunKey := False; { Done pressing function key }
  691.               Read(Kbd,Ch); { Get 2nd character of code }
  692.               Case Ch Of
  693.                 #71 : Begin { Case home }
  694.                         PagePointer := 0; { Top of list }
  695.                         WriteScreen;
  696.                       End; { Case home }
  697.                 #79 : Begin { Case end }
  698.                         PagePointer := (InCount - 22); { Bottom of list }
  699.                         If PagePointer < 0 Then
  700.                           PagePointer := 0;
  701.                         If InCount = 22 Then { Special case for TOL message }
  702.                           PagePointer := 1;
  703.                         WriteScreen;
  704.                       End; { Case end }
  705.                 #73 : Begin { Case page up }
  706.                         PagePointer := PagePointer - 23; { Up in list }
  707.                         If PagePointer < 0 Then { Exceeded top of list }
  708.                           PagePointer := 0; { Top }
  709.                         WriteScreen;
  710.                       End; { Case page up }
  711.                 #81 : Begin { Case page down }
  712.                         Ch := 'a'; { # 81 is a 'Q' and we don't want to quit }
  713.                         PagePointer := PagePointer + MaxDetailLines; { Down }
  714.                         If PagePointer > (InCount - 22) Then { Exceeded list }
  715.                           Begin { Then }
  716.                             PagePointer := (InCount - 22); { Bottom }
  717.                             If PagePointer < 0 Then
  718.                               PagePointer := 0;
  719.                           End; { Then }
  720.                         If InCount = 22 Then 
  721.                           PagePointer := 1;
  722.                         WriteScreen;
  723.                       End; { Case page down }
  724.               End; { Case }
  725.             End { Then }
  726.           Else
  727.             If Ch = #81 Then
  728.               Ch := 'a'; { Page down returns a 'Q' and we don't want to quit }
  729.           If (Upcase(Ch) In ['B','E','S']) And (InCount > 21) Then
  730.             Begin { Then } { Skip halfway to beginning or end, }
  731.               Case Ch Of   { or skip to a particular sequence }
  732.                 'B','b' : PagePointer := PagePointer Div 2;
  733.                 'E','e' : Begin { Case E }
  734.                             PagePointer := PagePointer +
  735.                             (InCount - PagePointer) Div 2;
  736.                             If PagePointer > (InCount - 21) Then
  737.                               Begin { Then }
  738.                                 PagePointer := (InCount - 21);
  739.                                 If PagePointer < 0 Then
  740.                                   PagePointer := 0;
  741.                               End; { Then }
  742.                           End; { Case E }
  743.                 'S','s' : Begin { Case S }
  744.                             { Restore standard screen output driver }
  745.                             ConOutPtr := AuxOutPtr;
  746.                             ClrScr;
  747.                             Repeat { 2 repeat loops to get valid seek # }
  748.                               Repeat
  749.                                 Write('Enter sequence number between 1 and ');
  750.                                 Write(InCount,' to seek: ');
  751.                                 {$I-} Readln(PagePointer); {$I+}
  752.                                 OK := IOResult = 0;
  753.                                 If Not OK Then
  754.                                   Write(^G); { Beep to indicate entry error }
  755.                                 Writeln;
  756.                               Until OK;
  757.                               AllOK := (PagePointer >= 1) And
  758.                                        (PagePointer <= InCount);
  759.                               PagePointer := Pred(PagePointer);
  760.                               If Not AllOK Then
  761.                                 Write(^G); { Beep to indicate entry error }
  762.                             Until AllOK;
  763.                             If PagePointer > (InCount - 21) Then
  764.                               Begin { Then }
  765.                                 PagePointer := (InCount - 21);
  766.                                 If PagePointer < 0 Then
  767.                                   PagePointer := 0;
  768.                               End; { Then }
  769.                             { Go back to IO driver for view screen }
  770.                             ConOutPtr := Ofs(MemoryWrite);
  771.                           End; { Case S }
  772.               End; { Case }
  773.               WriteScreen; { After "B","E", or "S" entry }
  774.             End; { Then }
  775.         Until Upcase(Ch) = 'Q'; { Until user quits the viewer }
  776.       End { Then }
  777.     Else
  778.       Begin { Else }
  779.         Row := 19; { Row & col for printing error message }
  780.         Col := 10;
  781.         Write('No objects to view - Press Space To Continue ');
  782.         WaitForSpace;
  783.         ClrScr; { Clear the larger view window before returning to main menu }
  784.       End; { Else }
  785.     ConOutPtr := AuxOutPtr; { Restore standard screen output driver }
  786.   End; { Procedure View }
  787.  
  788. Procedure Terminate;
  789. { This procedure is called when the user Quits the program }
  790.   Var
  791.     ActiveTime,ActiveHours,ActiveMinutes,ActiveSeconds : Real;
  792.   Begin { Procedure Terminate }
  793.     Window(1,1,80,25); { Restore full screen window }
  794.     ClrScr; { Leave the DOS level screen uncluttered except for final message }
  795.     FinishTime := Time; { Used To determine program run time }
  796.     If FinishTime < StartTime Then
  797.       FinishTime := FinishTime + 86400.0; { Add 24 hours after midnight }
  798.     ActiveTime := FinishTime - StartTime; { Program run time in seconds }
  799.     ActiveHours := Int(ActiveTime / 3600);
  800.     ActiveMinutes := Int((ActiveTime - ActiveHours * 3600) / 60);
  801.     ActiveSeconds := ActiveTime - ActiveHours * 3600 - ActiveMinutes * 60;
  802.     Write('Hbase active for ');
  803.     If ActiveHours > 0 Then
  804.       If ActiveHours > 1 Then
  805.         Write(ActiveHours:2:0,' hours ')
  806.       Else
  807.         Write(ActiveHours:2:0,' hour ');
  808.     If ActiveMinutes > 0 Then
  809.       If ActiveMinutes > 1 Then
  810.         Write(ActiveMinutes:2:0,' minutes ')
  811.       Else
  812.         Write(ActiveMinutes:2:0,' minute ');
  813.     If ActiveSeconds > 1 Then
  814.       Write(ActiveSeconds:2:0,' seconds')
  815.     Else
  816.       Write(ActiveSeconds:2:0,' second');
  817.     Writeln(' - returning to DOS ...');
  818.   End; { Procedure Terminate }
  819.  
  820. {$I SELECTS.INC}  { Include parameter selection procedures }
  821.  
  822. Procedure Precess;
  823. { This procedure precesses the selected data's celestial coordinates to
  824.   another epoch. The algolrithm is taken from Eric Burgess' CELESTIAL BASIC,
  825.   and it is not as accurate as I would like. If you improve on it (even at a
  826.   loss of speed), please let me know, 'cause I could use it myself. }
  827.   Var
  828.     R1,D1,T2,ChangeInRA,ChangeInDec,NewEpoch,
  829.     RealMins,Difference,X,Y,Z,LastYear : Real;
  830.  
  831.   Function Tan (AngleInDegrees : Real): Real;
  832.     { Represents the tangent of its degree-valued argument }
  833.     Var
  834.       Angle : Real;
  835.     Function ConvertToRadians(Angle : Real): Real;
  836.       Begin { Function ConvertToRadians }
  837.         ConvertToRadians := Angle * (Pi / 180);
  838.       End; { Function ConvertToRadians }
  839.     Begin { Function Tan }
  840.       Angle := ConvertToRadians(AngleInDegrees);
  841.       Tan := Sin(Angle) / Cos(Angle);
  842.     End; { Function Tan }
  843.  
  844.   Begin { Procedure Precess }
  845.     If NewSelection Then
  846.       Sort; { User cannot precess data until it is sorted }
  847.     If Selected And (InCount > 0) Then
  848.       Begin { Then }
  849.         ClrScr;
  850.         LastYear := CurrentEpoch;
  851.         Repeat
  852.           Write('Enter the new epoch: ');
  853.           {$I-} Readln(NewEpoch) {$I+};
  854.           OK := (IOResult = 0);
  855.           If Not OK Then
  856.             Write(^G); { Ring bell to alert user to entry error }
  857.           Writeln;
  858.         Until OK;
  859.         ClrScr;
  860.         Writeln('Selected data being precessed to epoch ',NewEpoch:7:2);
  861.         Difference := NewEpoch - LastYear;
  862.         CurrentEpoch := NewEpoch;
  863.         For Index := 1 To InCount Do
  864.           Begin { For }
  865.             Object := SelectArray[Index]; { Get next object to precess }
  866.             With Object Do { Precess it }
  867.               Begin { With }
  868.                 R1 := RAHrs + RAMins / 60 + RASecs / 3600;
  869.                 D1 := DecDeg + DecMin / 60;
  870.                 R1 := R1 * 15;
  871.                 T2 := ((LastYear + NewEpoch) / 2 - 1900) / 100;
  872.                 X := 3.07234 + (0.00186 * T2);
  873.                 Y := 20.0468 - (0.0085 * T2);
  874.                 Z := Y / 15;
  875.                 ChangeInRA := 0.0042 * Difference *
  876.                   (X + (Z * Sin(R1/57.29878) * Tan(D1/57.29878)));
  877.                 R1 := R1 + ChangeInRA;
  878.                 D1 := D1  + 0.00028 * Difference * Y * Cos(R1 / 57.29878);
  879.                 R1 := R1 / 15;
  880.                 If R1 > 24 Then
  881.                   R1 := R1 - 24;
  882.                 If R1 < 0 Then
  883.                   R1 := R1 + 24;
  884.                 RAHrs := Trunc(Int(R1));
  885.                 RealMins := (60 * (R1 - Int(R1)));
  886.                 RASecs := Trunc(60 * (RealMins - Int(RealMins)));
  887.                 RAMins := Trunc(RealMins);
  888.                 If D1 > 90 Then
  889.                   D1 := 90 - (D1 - Int(D1));
  890.                 DecDeg := Trunc(Int(D1));
  891.                 DecMin := Trunc((D1 - Int(D1)) * 60);
  892.                 If D1 < 0 Then
  893.                   Begin { Then }
  894.                     DecDeg := Trunc(Int(D1));
  895.                     D1 := Abs(D1);
  896.                     DecMin := Trunc(60 * (D1 - Int(D1)));
  897.                   End; { Then }
  898.               End; { With }
  899.             SelectArray[Index] := Object; { Put precessed object back }
  900.           End; { For }
  901.       End { Then }
  902.     Else
  903.       Begin { Else }
  904.         If InCount > 0 Then { Selected = False }
  905.           Writeln('No data has been selected for precession')
  906.         Else { Incount = 0 }
  907.           Writeln('  No objects to precess');
  908.         Write    (' Press space to continue ');
  909.         WaitForSpace;
  910.       End; { Else }
  911.   End; { Procedure Precess }
  912.  
  913. Procedure ExamineStatus; { Show selected values to user }
  914.   Var
  915.     Index,ConCount : Byte;
  916.     ConSelected : Boolean;
  917.   Begin { Procedure ExamineStatus }
  918.     ClrScr;
  919.     Window(20,1,80,25); { Center status display screen }
  920.     Writeln;
  921.     ConCount := 0;
  922.     ConSelected := False;
  923.     HighVideo; Writeln('Current selected values are:'); LowVideo;
  924.     Writeln;
  925.     Write('Sorted by ');
  926.     Case SortField Of
  927.       'H','h',' ' : Writeln('Herschel class.');
  928.       'N','n' : Writeln('NGC number.');
  929.       'R','r' : Writeln('right ascension.');
  930.       'D','d' : Writeln('declination.');
  931.       'M','m' : Writeln('magnitude.');
  932.       'O','o' : Writeln('object type.');
  933.       'C','c' : Writeln('constellation.');
  934.     End; { Case }
  935.     Writeln;
  936.     If ClassSet  >= [1..8] Then
  937.       Writeln('All Herschel classes.')
  938.     Else
  939.       Begin { Else }
  940.         Write('Herschel class(es) ');
  941.         For Index := 1 To 8 Do
  942.           If Index In ClassSet Then
  943.             Write(ClassNames[Index],' ');
  944.         Writeln;
  945.       End; { Else }
  946.     Writeln;
  947.     If (LowNGC <= 0) And (HighNGC >= 8000) Then
  948.       Writeln('All NGC numbers.')
  949.     Else
  950.       Writeln('NGC numbers from ',LowNGC,' to ',HighNGC);
  951.     Writeln;
  952.     If (LowRAHr <= 0) And (LowRAMin <= 0) And (HighRAHr >= 24)
  953.         And (HighRAMin >= 60) Then
  954.       Writeln('All r.a. values.')
  955.     Else
  956.       Writeln('R.A. from ',LowRAHr,' Hrs, ',LowRAMin,' Min to ',
  957.                HighRAHr,' Hrs, ',HighRAMin,' Min.');
  958.     Writeln;
  959.     If (LowDecDeg <= -90) And (LowDecMin <= -60) And (HighDecDeg >= 90) And
  960.        (HighDecMin >= 60) Then
  961.       Writeln('All Dec. values.')
  962.     Else
  963.       Writeln('Dec. from ',LowDecDeg,' Deg, ',LowDecMin,' Min to ',
  964.                HighDecDeg,' Deg, ',HighDecMin,' Min.');
  965.     Writeln;
  966.     If (LowMag <= 0) And (HighMag >= 170.0) Then
  967.       Writeln('All magnitudes.')
  968.     Else
  969.       Writeln('Magnitudes from ',(LowMag/10):4:1,' to ',(HighMag/10):4:1,'.');
  970.     Writeln;
  971.     If TypeSet  >= [1..7] Then
  972.       Writeln('All object types.')
  973.     Else
  974.       Begin { Else }
  975.         Write('Object type(s) ');
  976.         For Index := 1 To 7 Do
  977.           If Index In TypeSet Then
  978.             Write(ObjectTypes[Index],' ');
  979.         Writeln;
  980.       End; { Else }
  981.     Writeln;
  982.     For Index := 1 To NumberOfConstellations Do
  983.       If Not Constel[Index] Then
  984.         Begin { Then }
  985.           ConSelected := True;
  986.           ConCount := Succ(ConCount);
  987.         End; { Then }
  988.       If Not ConSelected Then
  989.         Writeln('All Constellations.')
  990.     Else
  991.       If ConCount = NumberOfConstellations Then
  992.         Writeln('No Constellations.')
  993.       Else
  994.         Begin { Else }
  995.           Writeln('The following constellation(s):');
  996.           ConCount := 0;
  997.           For Index := 1 To NumberOfConstellations Do
  998.             Begin { For }
  999.               If Constel[Index] Then
  1000.                 Begin { Then }
  1001.                   ConCount := Succ(ConCount);
  1002.                   If ConCount > 14 Then
  1003.                     Begin { Then }
  1004.                       Writeln;
  1005.                       ConCount := 0;
  1006.                     End { Then }
  1007.                   Else
  1008.                     Write(Names[Index],' ');
  1009.                 End; { Then }
  1010.             End; { For }
  1011.         End; { Else }
  1012.     Writeln; Writeln;
  1013.     HighVideo; Write('Press space to return to main menu '); LowVideo;
  1014.     WaitForSpace;
  1015.   End; { Procedure ExamineStatus }
  1016.  
  1017. {$I HELP.INC}  { Include the online help procedure }
  1018.  
  1019. Procedure MainMenu;
  1020. { This is the main menu called by the main program }
  1021.   Begin { Procedure MainMenu }
  1022.     ClrScr;
  1023.     Window(11,1,80,25); { Center the main menu screen }
  1024.     LowVideo; { Some procedures return in HighVideo mode }
  1025.     Writeln;
  1026.     If InCount <> 1 Then { Test to keep our grammar correct }
  1027.       Writeln('There are currently ',InCount,' objects selected.')
  1028.     Else
  1029.       Writeln('There is currently 1 object selected.');
  1030.     Writeln;
  1031.     HighVideo;
  1032.     If NewSelection Then { New selections not yet sorted - warn the user }
  1033.       Begin { Then }
  1034.         Writeln('New selections have not been sorted.');
  1035.         Writeln;
  1036.       End; { Then }
  1037.     If Expanding Then { Notify the user }
  1038.       Begin { Then }
  1039.         Writeln('Selections are being expanded.');
  1040.         Writeln;
  1041.       End; { Then }
  1042.     LowVideo;
  1043.     Writeln('You can select a sub-listing by:');
  1044.     Writeln;
  1045.     HighVideo; Write('  H'); LowVideo; Writeln('erschel Class');
  1046.     HighVideo; Write('  N'); LowVideo; Writeln('GC Number');
  1047.     HighVideo; Write('  R'); LowVideo; Writeln('ight Ascension');
  1048.     HighVideo; Write('  D'); LowVideo; Writeln('eclination');
  1049.     HighVideo; Write('  M'); LowVideo; Writeln('agnitude');
  1050.     HighVideo; Write('  O'); LowVideo; Writeln('bject Type');
  1051.     HighVideo; Write('  C'); LowVideo; Writeln('onstellation');
  1052.     Writeln;
  1053.     Write('Type a letter to select, or to ');
  1054.     HighVideo; Write('S'); LowVideo; Write('ort, ');
  1055.     HighVideo; Write('T'); LowVideo; Writeln('oggle expansion, ');
  1056.     HighVideo; Write('E'); LowVideo; Write('xamine status, ');
  1057.     HighVideo; Write('I'); LowVideo; Write('nitialize, ');
  1058.     HighVideo; Write('V'); LowVideo; Write('iew, ');
  1059.     HighVideo; Write('L'); LowVideo; Write('ist, ');
  1060.     HighVideo; Write('P'); LowVideo; Write('recess, or ');
  1061.     HighVideo; Write('Q'); LowVideo; Writeln('uit.');
  1062.     Writeln;
  1063.     Write('You may type '); HighVideo; Write('F1 '); LowVideo;
  1064.     Writeln('for help.');
  1065.     Writeln;
  1066.     Write('Your Choice? ');
  1067.     Repeat
  1068.       Read(Kbd,Ch);
  1069.     Until Upcase(Ch) In ['H','N','R','D','M','C','O','E',
  1070.                          #27,'T','I','S','V','L','P','Q'];
  1071.     HighVideo; Writeln(Ch); LowVideo;
  1072.     Writeln;
  1073.     Case Ch Of
  1074.       #27 : Begin { Check for PF1 (help) else ignore extended code keys }
  1075.               If Keypressed Then
  1076.                 Read(Kbd,Ch); { Get 2nd character of extended scan code }
  1077.                 If Ch = #59 Then { PF1 was pressed }
  1078.                   MainMenuHelp
  1079.                 Else
  1080.                   Ch := ' '; { Space out unwanted 2nd character }
  1081.             End; { Case escape }
  1082.       'H','h' : SelectH;
  1083.       'N','n' : SelectNGC;
  1084.       'R','r' : SelectRA;
  1085.       'D','d' : SelectDec;
  1086.       'M','m' : SelectMag;
  1087.       'O','o' : SelectType;
  1088.       'C','c' : SelectCon;
  1089.       'E','e' : ExamineStatus;
  1090.       'I','i' : InitializeVariables;
  1091.       'L','l' : List;
  1092.       'P','p' : Precess;
  1093.       'V','v' : View;
  1094.       'S','s' : Sort;
  1095.       'Q','q' : Begin { Case Q }
  1096.                   Write('Exit to DOS? (Y/N): ');
  1097.                   Repeat { Loop to catch those damn escape codes }
  1098.                     Repeat
  1099.                       Read(Kbd,Ch);
  1100.                     Until Upcase(Ch) In ['Y','N',#27];
  1101.                     If (Ch = #27) And Keypressed Then { Escape code pressed }
  1102.                       Begin { Then }
  1103.                         Read(Kbd,Ch); { Get 2nd char of escape code }
  1104.                         Ch := 'a'; { Weed out unwanted "y"s & "n"s }
  1105.                       End; { Then }
  1106.                   Until Upcase(Ch) In ['Y','N'];
  1107.                   Writeln(Ch);
  1108.                   Done := Upcase(Ch) = 'Y';
  1109.                 End; { Case Q }
  1110.       'T','t' : Begin { Case T }
  1111.                   Expanding := Not Expanding;
  1112.                   Selected := False;
  1113.                 End; { Case T }
  1114.     End; { Case }
  1115.   End; { Procedure MainMenu }
  1116.  
  1117. Begin { Program }
  1118.   Initialize;
  1119.   While Not Done Do
  1120.     MainMenu;
  1121.   Terminate;
  1122. End. { Program }
  1123.